Random Forests: Sirve para todo?

Objetivo

Predecir el consumo para los 3 meses siguiente dada una serie de datos del consumo previo junto a variables exogenas. Las variables next_consume, next_2_consume y next_3_consume son las variables dependientes que queremos predecir.

Cargar Bibliotecas

install.packages("readr")

Error in install.packages : Updating loaded packages

install.packages("ranger")

Error in install.packages : Updating loaded packages

install.packages("dplyr")

Error in install.packages : Updating loaded packages

install.packages("skimr")

Error in install.packages : Updating loaded packages

install.packages("caret")

Error in install.packages : Updating loaded packages

library(readr) # para leeer el dataset
library(ranger) # random forest con esteroides
library(dplyr) # para manipular datos
library(skimr) # para mirar los datos
library(caret) # framework de machine learning

Cargar el dataset

# dataset %>% select(Date)
# dataset %>% names() %>% as.data.frame()

 skimr::skim(dataset)# %>% knitr::kable() %>% kable_styling(font_size = 9)

── Data Summary ────────────────────────
                           Values 
Name                       dataset
Number of rows             532    
Number of columns          409    
_______________________           
Column type frequency:            
  numeric                  409    
________________________          
Group variables            None   

La Metodologia

dataset <- dataset %>% tidyr::drop_na()
train<-dataset %>% sample_frac(0.8)
test <-setdiff(dataset,train)
train

test

Modelo para predecir next_consume

rf_model1 <- ranger(tmg ~ . ,data=train, splitrule = "maxstat")
rf_model1

Ranger result

Call:
 ranger(tmg ~ ., data = train, splitrule = "maxstat") 

Type:                             Regression 
Number of trees:                  500 
Sample size:                      426 
Number of independent variables:  408 
Mtry:                             20 
Target node size:                 5 
Variable importance mode:         none 
Splitrule:                        maxstat 
OOB prediction error (MSE):       0.001165064 
R squared (OOB):                  0.8066949 

testThing <- function(splitrule) {
  rf_model1 <- ranger(tmg ~ . ,data=train, splitrule = splitrule)
  predictions_test <- predict(rf_model1, data = test)$predictions
  RMSE_test <- sqrt(mean((predictions_test - test$tmg)^2))
  predictions_train <- predict(rf_model1, data = train)$predictions
  RMSE_train <- sqrt(mean((predictions_train - train$tmg)^2))
  return(c(RMSE_train, RMSE_test))
}
testNTimes <- function(splitrule, n) {
  results <- matrix(0, n, 2)
  for (i in 1:n) {
    result <- testThing(splitrule)
    results[i, ] <- result
  }
  avg_RMSE_train <- mean(results[, 1])
  avg_RMSE_test <- mean(results[, 2])
  return(c(avg_RMSE_train, avg_RMSE_test))
}
testNTimes("variance", 100)

[1] 0.01528344 0.03396292

testNTimes("extratrees", 100)

[1] 0.01861879 0.03461950

testNTimes("maxstat", 100)

[1] 0.02263960 0.03593478

# rf_model1$prediction.error
predictions <- predict(rf_model1, data = test)$predictions
# Compute the RMSE (Root Mean Square Error)
RMSE <- sqrt(mean((predictions - test$tmg)^2))

print(rf_model1$prediction.error)
print(RMSE)

Entrenamiento

Out Of Box Sampling.

Los errores MSE y R squared se calculan sobre el OOB. El concepto de OOB está relacionado con el proceso de bootstrapping, que es una técnica de muestreo utilizada en la construcción de los árboles de decisión en Random Forest. En bootstrapping, se extrae una muestra aleatoria de los datos de entrenamiento con reemplazo, lo que significa que algunas instancias pueden ser elegidas varias veces, mientras que otras pueden no ser elegidas en absoluto.

Importancia de las variables

rf_model1 <- ranger(tmg ~ . ,data=train, importance = "impurity")
rf_model1

impurity: Este es el método predeterminado, que calcula la importancia de una característica basándose en la disminución de la impureza del nodo (por ejemplo, Gini o entropía) cuando una característica se utiliza para dividir en los árboles de decisión. Cuanto mayor sea la disminución de la impureza, más importante se considera la característica.

rf_model1$variable.importance
data.frame(impurity=rf_model1$variable.importance) %>% arrange(desc(impurity))

rf_model1 <- ranger(tmg ~ pec_28 + pec_27 + pec_32 + pec_62 + psd12_58 + psd12_50 + psd11_58 + pec_51 + psd11_50 + pec_29,data=train, importance = "impurity")
rf_model1

Prediccion

predictions1 <- predict(rf_model1,data = test, type='response')
predictions1$predictions %>% as.data.frame

Error MSE en test

mse<-function(act,pred) {mean((act- pred)^2)}

data.frame(pred=predictions1$predictions, act=test$tmg) %>% summarise(mse=mse(act,pred))

Intervalos de prediccion (quantile regression)

En vez de utilizar el promedio se utilzan los cuantiles para tener un intervalo de predicción (Meinshausen, 2006). A la hora de realizar el split, en vez de utilizar MSE o alguna otra metrica de impureza, se utiliza una metrica que tiene en cuenta a los cuantiles . Luego en cada hoja en vez de calcular el promedio, se calculan cuantiles.

rf_model1 <- ranger(tmg ~ . ,data=train, importance = "impurity",quantreg = TRUE)
rf_model1

predictions1 <- predict(rf_model1,data = test, type= "quantiles")
predictions1$predictions %>% as.data.frame()

p1<-data.frame(predictions1$predictions,act=test$tmg,label="Mag prediction")

p1  %>% ggplot()+
  geom_point(aes(x=act,y=quantile..0.5),color='red')+
  geom_errorbar(aes(x=act,y=quantile..0.5,ymax=quantile..0.9,ymin=quantile..0.1),color='orange')+
  theme_classic()

Intervalo de confianza

Similar al intervalo de prediccion. En las implementaciones de Random Forests, suele confudirse. En terminos generales, uno se aplica sobre una observacion/predicción en general, mientras que el otro trata sobre estadisticos. Un ejemplo seria, la diferencia entre desviacion estandar de una variable y el error estandar sobre un conjunto de muestras.

If we change the training dataset just a little bit, will Random Forest give you the same result for that particular example?

(Wagner et al. 2014) Basado en una tecnica que se llama jacknife.

rf_model1 <- ranger(tmg ~ ., data=train, importance = "impurity",keep.inbag  = TRUE)
rf_model1

predictions1 <- predict(rf_model1,data = train, type= "se")

predictions1$predictions %>% as.data.frame()
predictions1$se %>% as.data.frame()

data.frame(pred=predictions1$predictions, se= predictions1$se, act=train$tmg) %>% ggplot()+
  geom_point(aes(x=act,y=pred),color='red')+
  geom_errorbar(aes(x=act,y=pred,ymax=pred+se,ymin=pred-se),color='orange')+
  theme_classic()